EDA Dataset Qualidade de Vinhos

Utilizando a base descrita e disponibilizada em aula o objetivo do trabalho é mensurar a variável “Quality” dos vinhos desta região de Portugal com as variáveis de características (composição) dos vinhos.

Objetivos

Etapa 1 (Base)

Avaliar se a análise será feita com os dois tipos de vinhos juntos ou se separaria por tipo para analisá-los.
Análise exploratória de dados: Detecção de outliers, gráficos e análise sobre os dois tipos de vinhos. Correlações entre elas (numéricas e gráficos).
Conclusão: colocar qual a opção seguirá sobre os tipos de vinhos , sobre os outliers (caso tenha) e o uso de Componentes Principais

Etapa 2 (Algoritmos explicar variável Quality)

Modelo 1: Regressão Linear
Modelo 2: Árvore de regressão
Para cada modelo fazer as análises adequadas como:
explicar a técnica
qual a variável dependente,
quais são as variáveis independentes,
relações entre elas (numéricas e gráficos) (verificar se todas já foram efetuadas adequadamente na parte 1.
saída do modelo (análise)
qualidade do modelo
O que cada modelo gerou de resultados?
Comparação entre modelos
Utilizando as métricas adequadas para comparação de modelos façam um resumo sobre a qualidade dos modelos e indiquem qual o modelo/ técnica que vocês recomendariam

Etapa 3 (Algoritmos explicar variável “Quality”: Vinhos bons e ruins)

Modelo 1: Árvore de decisão
Modelo 2: Regressão Logística
Para cada modelo fazer as análises adequeadas como:
explicar a técnica
qual a variável dependente,
quais são as variáveis independentes,
relações entre elas (numéricas e gráficos) (verificar se todas já foram efetuadas adequadamente na parte 1.
saída do modelo (análise)
qualidade do modelo
O que cada modelo gerou de resultados?
Comparação dos modelos
Utilizando as métricas adequadas para comparação de modelos façam um resumo sobre a qualidade dos modelos e indiquem qual o modelo/ técnica que vocês recomendariam

Etapa 4 (Análise sobre outras possíveis técnicas)

quais outras técnicas supervisionadas vocês indicariam como adequadas para esta análise?
e, das técnicas Não Supervisionadas, quais?

Etapa 1 - Análisa do dataset

require(DT)

## Loading required package: DT

require(plotly)

## Loading required package: plotly

## Loading required package: ggplot2

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

require(dplyr)

## Loading required package: dplyr

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

require(corrgram)

## Loading required package: corrgram

require(outliers)

## Loading required package: outliers

require(caTools)     # data splitting

## Loading required package: caTools

require(dplyr)       # data wrangling
require(rpart)       # performing regression trees

## Loading required package: rpart

require(rpart.plot)  # plotting regression trees

## Loading required package: rpart.plot

require(ipred)       # bagging

## Loading required package: ipred

require(caret)       # bagging

## Loading required package: caret

## Loading required package: lattice

## 
## Attaching package: 'lattice'

## The following object is masked from 'package:corrgram':
## 
##     panel.fill

require(pROC)

## Loading required package: pROC

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

Vinhos <- read.csv2("BaseWine_Red_e_White2018.csv", row.names=1)
attach(Vinhos)
head(Vinhos)

##   fixedacidity volatileacidity citricacid residualsugar chlorides
## 1          6.6            0.24       0.35          7.70     0.031
## 2          6.7            0.34       0.43          1.60     0.041
## 3         10.6            0.31       0.49          2.20     0.063
## 4          5.4            0.18       0.24          4.80     0.041
## 5          6.7            0.30       0.44         18.75     0.057
## 6          6.8            0.50       0.11          1.50     0.075
##   freesulfurdioxide totalsulfurdioxide density   pH sulphates alcohol
## 1                36                135 0.99380 3.19      0.37    10.5
## 2                29                114 0.99014 3.23      0.44    12.6
## 3                18                 40 0.99760 3.14      0.51     9.8
## 4                30                113 0.99445 3.42      0.40     9.4
## 5                65                224 0.99956 3.11      0.53     9.1
## 6                16                 49 0.99545 3.36      0.79     9.5
##   quality Vinho
## 1       5 WHITE
## 2       6 WHITE
## 3       6   RED
## 4       6 WHITE
## 5       5 WHITE
## 6       5   RED

Temos um total de 13 colunas, com duas possíveis variáveis targets a variável quality e Vinho. A coluna Vinho já está corretamente indicada como sendo categórica, e podemos fazer a mesma coisa para quality mais pra frente se acharmos necessário.

Identificar NAs

sapply(Vinhos, function(x) sum(is.na(x)))

##       fixedacidity    volatileacidity         citricacid 
##                  0                  0                  0 
##      residualsugar          chlorides  freesulfurdioxide 
##                  0                  0                  0 
## totalsulfurdioxide            density                 pH 
##                  0                  0                  0 
##          sulphates            alcohol            quality 
##                  0                  0                  0 
##              Vinho 
##                  0

Conseguimos observar que não temos nenhum valor faltante nesse dataset, eliminando a necessidade de tratar esses valores.

Resumo dos dados

summary(Vinhos)

##   fixedacidity    volatileacidity    citricacid     residualsugar  
##  Min.   : 3.800   Min.   :0.0800   Min.   :0.0000   Min.   : 0.60  
##  1st Qu.: 6.400   1st Qu.:0.2300   1st Qu.:0.2500   1st Qu.: 1.80  
##  Median : 7.000   Median :0.2900   Median :0.3100   Median : 3.00  
##  Mean   : 7.215   Mean   :0.3397   Mean   :0.3186   Mean   : 5.44  
##  3rd Qu.: 7.700   3rd Qu.:0.4000   3rd Qu.:0.3900   3rd Qu.: 8.10  
##  Max.   :15.900   Max.   :1.5800   Max.   :1.6600   Max.   :45.80  
##    chlorides       freesulfurdioxide totalsulfurdioxide    density      
##  Min.   :0.00900   Min.   :  1.00    Min.   :  6.0      Min.   :0.9871  
##  1st Qu.:0.03800   1st Qu.: 17.00    1st Qu.: 77.0      1st Qu.:0.9923  
##  Median :0.04700   Median : 29.00    Median :118.0      Median :0.9949  
##  Mean   :0.05603   Mean   : 30.53    Mean   :115.7      Mean   :0.9947  
##  3rd Qu.:0.06500   3rd Qu.: 41.00    3rd Qu.:156.0      3rd Qu.:0.9970  
##  Max.   :0.61100   Max.   :289.00    Max.   :440.0      Max.   :1.0140  
##        pH          sulphates         alcohol           quality     
##  Min.   :2.720   Min.   :0.2200   Min.   : 0.9567   Min.   :3.000  
##  1st Qu.:3.110   1st Qu.:0.4300   1st Qu.: 9.5000   1st Qu.:5.000  
##  Median :3.210   Median :0.5100   Median :10.3000   Median :6.000  
##  Mean   :3.219   Mean   :0.5313   Mean   :10.4862   Mean   :5.818  
##  3rd Qu.:3.320   3rd Qu.:0.6000   3rd Qu.:11.3000   3rd Qu.:6.000  
##  Max.   :4.010   Max.   :2.0000   Max.   :14.9000   Max.   :9.000  
##    Vinho     
##  RED  :1599  
##  WHITE:4898  
##              
##              
##              
##

Aqui podemos observar que residualsugar, chlorides, freesulfurdioxide e totalsulfurdioxide tem valores muito espaçados de minimos e máximos, podendo indicar alguns outliers e também há uma falta de equilíbrio entre a quantidade de vinhos RED e WHITE podendo interferir nos resultados de classificação.

Visualizando as features

BoxPlot das features

p1 <- plot_ly(y = fixedacidity, type="box", name = "Fixed Acidity")
p2 <- plot_ly(y = volatileacidity, type="box", name = "Volatile Acidity")
p3 <- plot_ly(y = citricacid, type="box", name = "Citric Acid")
p4 <- plot_ly(y = residualsugar, type="box", name = "Residual Sugar")
p5 <- plot_ly(y = chlorides, type="box", name = "Chlorides")
p6 <- plot_ly(y = freesulfurdioxide, type="box", name = "Free Sulfur Dioxide")
subplot(p1, p2, p3, p4, p5, p6, nrows=3)

p7 <- plot_ly(y = totalsulfurdioxide, type="box", name = "Total Sulfur Dioxide")
p8 <- plot_ly(y = density, type="box", name = "Density")
p9 <- plot_ly(y = pH, type="box", name = "PH")
p10 <- plot_ly(y = sulphates, type="box", name = "Sulphates")
p11 <- plot_ly(y = alcohol, type="box", name = "Alcohol")
p12 <- plot_ly(y = quality, type="box", name = "Quality")
subplot(p7, p8, p9, p10, p11, p12, nrows=3)

Historigramas das features

p1 <- plot_ly(x = fixedacidity, type="histogram", name = "Fixed Acidity")
p2 <- plot_ly(x = volatileacidity, type="histogram", name = "Volatile Acidity")
p3 <- plot_ly(x = citricacid, type="histogram", name = "Citric Acid")
p4 <- plot_ly(x = residualsugar, type="histogram", name = "Residual Sugar")
p5 <- plot_ly(x = chlorides, type="histogram", name = "Chlorides")
p6 <- plot_ly(x = freesulfurdioxide, type="histogram", name = "Free Sulfur Dioxide")
subplot(p1, p2, p3, p4, p5, p6, nrows=3)

p7 <- plot_ly(x = totalsulfurdioxide, type="histogram", name = "Total Sulfur Dioxide")
p8 <- plot_ly(x = density, type="histogram", name = "Density")
p9 <- plot_ly(x = pH, type="histogram", name = "PH")
p10 <- plot_ly(x = sulphates, type="histogram", name = "Sulphates")
p11 <- plot_ly(x = alcohol, type="histogram", name = "Alcohol")
p12 <- plot_ly(x = quality, type="histogram", name = "Quality")
subplot(p7, p8, p9, p10, p11, p12, nrows=3)

Etapa 1 - Análise sobre os dois tipos de vinhos

BoxPlot

p1 <- plot_ly(x = Vinho, y = fixedacidity, color = Vinho, type="box", name = "Fixed Acidity")
p2 <- plot_ly(x = Vinho, y = volatileacidity, color = Vinho, type="box", name = "Volatile Acidity")
subplot(p1, p2, nrows=1)

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

p3 <- plot_ly(x = Vinho, y = citricacid, color = Vinho, type="box", name = "Citric Acid")
p4 <- plot_ly(x = Vinho, y = residualsugar, color = Vinho, type="box", name = "Residual Sugar")
subplot(p3, p4, nrows=1)

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

p5 <- plot_ly(x = Vinho, y = chlorides, color = Vinho, type="box", name = "Chlorides")
p6 <- plot_ly(x = Vinho, y = freesulfurdioxide, color = Vinho, type="box", name = "Free Sulfur Dioxide")
subplot(p5, p6, nrows=1)

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

p7 <- plot_ly(x = Vinho, y = totalsulfurdioxide, color = Vinho, type="box", name = "Total Sulfur Dioxide")
p8 <- plot_ly(x = Vinho, y = density, type="box", color = Vinho, name = "Density")
subplot(p7, p8, nrows=1)

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

p9 <- plot_ly(x = Vinho, y = pH, color = Vinho, type="box", name = "PH")
p10 <- plot_ly(x = Vinho, y = sulphates, color = Vinho, type="box", name = "Sulphates")
subplot(p9, p10, nrows=1)

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

p11 <- plot_ly(x = Vinho, y = alcohol, color = Vinho, type="box", name = "Alcohol")
p12 <- plot_ly(x = Vinho, y = quality, color = Vinho, type="box", name = "Quality")
subplot(p11, p12, nrows=1)

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

Descobertas:

Temos algumas características que se destacam para descrever a diferença entre os dois tipos de vinhos: Fixed Acidity, Volatile Acidity, Chlorides, Free Sulfur Dioxide, Total Sulfur Dioxide, Density, Sulphates.
As discrepâncias que existem nessas características entre os tipos de vinhos seriam úteis em uma tarefa de classificação.
Podemos observar que só o tipo WHITE tem observações com nota 9, e há apenas 1 observação com essa nota. Isso significa que nunca vamos associar um vinho RED com essa nota o que indica que o nosso modelo provavelmente não generalizaria muito bem, precisariamos de dados mais completos.
Podemos observar possíveis outliers que precisam ser investigados. Ex: Alcohol, temos observações com quase 0% de alcohol, precisa ser verificar se é possível ter observações não alcolicas nessa amostra ou é um erro.

Histogram

Separando os dados entre RED VS WHITE

Vinhos %>% 
  filter(Vinho == "RED") -> RED

Vinhos %>% 
  filter(Vinho == "WHITE") -> WHITE

Analisando o equilibrio dos dois grupos no dataset

plot_ly(x = Vinho, type="histogram", name = "RED VS WHITE")

Criando função para facilitar os plots

plot_hist <- function(data1, name1, data2, name2, feature, title) {
  trace1 <- list(
    x = data1[,feature], 
    marker = list(line = list(
      color = "rgb(217, 217, 217)", 
      width = 0
    )), 
    name = name1, 
    opacity = 0.75, 
    type = "histogram", 
  visible = TRUE
  )

  trace2 <- list(
    x = data2[,feature],
    marker = list(
      color = "rgb(23, 190, 207)", 
      line = list(
        color = "rgb(217, 217, 217)", 
        width = 0
      )
    ), 
    name = name2, 
    opacity = 0.75, 
    type = "histogram", 
    visible = TRUE
  )

  data <- list(trace1, trace2)

  layout <- list(
    autosize = TRUE, 
    barmode = "overlay", 
    height = 521, 
    hovermode = "closest", 
    legend = list(
      x = 1.0208, 
      y = 0.943734015345
    ), 
    margin = list(
      r = 50, 
      t = 65, 
      b = 65, 
      l = 65
    ), 
    showlegend = TRUE, 
    title = "", 
    width = 788, 
    xaxis = list(
      anchor = "y2", 
      autorange = TRUE, 
      range = c(-3.2795847824, 4.52178374944), 
      title = title, 
      type = "linear"
    ), 
    yaxis = list(
      autorange = TRUE, 
      domain = c(0.2, 1), 
      range = c(0, 0.0968421052632), 
      title = "Values", 
      type = "linear"
    )
  )

  p <- plot_ly() %>%
    add_trace(x=trace1$x, histnorm=trace1$histnorm, marker=trace1$marker, name=trace1$name, opacity=trace1$opacity, type=trace1$type, uid=trace1$uid, visible=trace1$visible, xbins=trace1$xbins) %>%
    add_trace(x=trace2$x, histnorm=trace2$histnorm, marker=trace2$marker, name=trace2$name, opacity=trace2$opacity, type=trace2$type, uid=trace2$uid, visible=trace2$visible, xbins=trace2$xbins) %>%
    layout(autosize=layout$autosize, barmode=layout$barmode, hovermode=layout$hovermode, legend=layout$legend, margin=layout$margin, showlegend=layout$showlegend, title=layout$title, xaxis=layout$xaxis, yaxis=layout$yaxis)
  
  p
}

plot_hist(RED, "RED", WHITE, "WHITE", "fixedacidity", "Fixed Acidity")

plot_hist(RED, "RED", WHITE, "WHITE", "volatileacidity", "Volatile Acidity")

plot_hist(RED, "RED", WHITE, "WHITE", "citricacid", "Citric Acid")

plot_hist(RED, "RED", WHITE, "WHITE", "residualsugar", "Residual Sugar")

plot_hist(RED, "RED", WHITE, "WHITE", "chlorides", "Chlorides")

plot_hist(RED, "RED", WHITE, "WHITE", "freesulfurdioxide", "Free Sulfur Dioxide")

plot_hist(RED, "RED", WHITE, "WHITE", "totalsulfurdioxide", "Total Sulfur Dioxide")

plot_hist(RED, "RED", WHITE, "WHITE", "density", "Density")

plot_hist(RED, "RED", WHITE, "WHITE", "pH", "PH")

plot_hist(RED, "RED", WHITE, "WHITE", "sulphates", "Sulphates")

plot_hist(RED, "RED", WHITE, "WHITE", "alcohol", "Alcohol")

Descobertas:

Podemos observar basicamente os mesmos destaques que algumas features apresentam entre os tipos de vinho RED vs WHITE que visualizamos no Box PLot.

Etapa 1 - Correlação entre as features

Correlação das features dos vinhos de todos os tipos em números

v <- Vinhos %>% select(c(quality,fixedacidity,volatileacidity,citricacid,residualsugar,
                                                 chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,
                                                 sulphates,alcohol))

vw  <- subset(Vinhos, Vinho=="WHITE", select=c(quality,fixedacidity,volatileacidity,citricacid,residualsugar,
                                                 chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,
                                                 sulphates,alcohol))
vr <- subset(Vinhos, Vinho=="RED", select=c(quality,fixedacidity,volatileacidity,citricacid,residualsugar,
                                                 chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,
                                                 sulphates,alcohol))

matcorV <- cor(v)
matcorVW <- cor(vw)
matcorVR <- cor(vr)
print(matcorV, digits = 2)

##                    quality fixedacidity volatileacidity citricacid
## quality              1.000       -0.077          -0.266      0.086
## fixedacidity        -0.077        1.000           0.219      0.324
## volatileacidity     -0.266        0.219           1.000     -0.378
## citricacid           0.086        0.324          -0.378      1.000
## residualsugar       -0.037       -0.113          -0.200      0.142
## chlorides           -0.201        0.298           0.377      0.039
## freesulfurdioxide    0.055       -0.283          -0.353      0.133
## totalsulfurdioxide  -0.041       -0.329          -0.414      0.195
## density             -0.310        0.465           0.270      0.095
## pH                   0.020       -0.253           0.261     -0.330
## sulphates            0.038        0.300           0.226      0.056
## alcohol              0.435       -0.102          -0.044     -0.008
##                    residualsugar chlorides freesulfurdioxide
## quality                   -0.037    -0.201             0.055
## fixedacidity              -0.113     0.298            -0.283
## volatileacidity           -0.200     0.377            -0.353
## citricacid                 0.142     0.039             0.133
## residualsugar              1.000    -0.130             0.406
## chlorides                 -0.130     1.000            -0.195
## freesulfurdioxide          0.406    -0.195             1.000
## totalsulfurdioxide         0.498    -0.280             0.721
## density                    0.543     0.367             0.028
## pH                        -0.270     0.045            -0.146
## sulphates                 -0.188     0.396            -0.188
## alcohol                   -0.353    -0.256            -0.173
##                    totalsulfurdioxide density     pH sulphates alcohol
## quality                        -0.041  -0.310  0.020     0.038   0.435
## fixedacidity                   -0.329   0.465 -0.253     0.300  -0.102
## volatileacidity                -0.414   0.270  0.261     0.226  -0.044
## citricacid                      0.195   0.095 -0.330     0.056  -0.008
## residualsugar                   0.498   0.543 -0.270    -0.188  -0.353
## chlorides                      -0.280   0.367  0.045     0.396  -0.256
## freesulfurdioxide               0.721   0.028 -0.146    -0.188  -0.173
## totalsulfurdioxide              1.000   0.032 -0.238    -0.276  -0.256
## density                         0.032   1.000  0.010     0.262  -0.688
## pH                             -0.238   0.010  1.000     0.192   0.121
## sulphates                      -0.276   0.262  0.192     1.000  -0.006
## alcohol                        -0.256  -0.688  0.121    -0.006   1.000

Correlação das features dos vinhos de todos os tipo visualização

corrgram(matcorV, type = "cor", lower.panel = panel.shade, upper.panel = panel.pie)

Correlação das features dos vinhos Brancos

corrgram(matcorVW, type = "cor", lower.panel = panel.shade, upper.panel = panel.pie)

Correlação das features dos vinhos Vermelhos

corrgram(matcorVR, type = "cor", lower.panel = panel.shade, upper.panel = panel.pie)

Descobertas:

Observamos que no dataset em geral Alcohol tem uma correlação positiva alta com Quality.
Densidade tem a maior correlação negativa com qualidade porém nada alarmante
Dióxido de Enxofre Livre e Dióxido de Enxofre Total tem uma grande correlação positiva e imagino que isso seja intuitivo, portanto podemos escolher apenas uma delas para usar no nosso modelo.
Outra variáveis como Fixed Acidity, Density, Residual Sugar tem grandes correlações positivas e negativas entre sí e podem ser analisadas para descarte caso necessário.
A correlação entre as variáveis dos vinhos WHITE e RED apresentam algumas divergências.
Os vinhos do tipo WHITE apresentam correlações consistentes com a matriz do dataset total, e isso pode ser explicado pelo fato de haver mais observações desse tipo de vinho, enquanto as do tipo RED apresentam variáveis como Volatile Acidity com correlação negativa a Quality e Citric Acid, Sulphates com correlação positiva maior com Quality. Fixed Acidity, Citric Acidity, Fixed Acidity, Density, PH, Volatile Acidity apresentam grandes correlações entre si tanto positivas como negativas, e podem ser analisadas para utilização de apenas uma dentre os pares.

Etapa 1 - PCA

v <- Vinhos %>% select(c(fixedacidity,volatileacidity,citricacid,residualsugar,
chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,sulphates,alcohol))

prcomp(v, scale = T)

## Standard deviations (1, .., p=11):
##  [1] 1.7411519 1.5791281 1.2464142 0.9854455 0.8453663 0.7789416 0.7235571
##  [8] 0.7094322 0.5820891 0.4780996 0.1856424
## 
## Rotation (n x k) = (11 x 11):
##                            PC1         PC2         PC3         PC4
## fixedacidity        0.24236004 -0.33547750  0.43240969 -0.16394790
## volatileacidity     0.38239507 -0.10993352 -0.30734109 -0.21119774
## citricacid         -0.15062616 -0.18663415  0.59062252  0.26551064
## residualsugar      -0.34375872 -0.33196390 -0.16573486 -0.16086481
## chlorides           0.29424864 -0.31037330 -0.01768063  0.24197100
## freesulfurdioxide  -0.42974116 -0.07978302 -0.13732085  0.35624480
## totalsulfurdioxide -0.48582963 -0.09495997 -0.10989691  0.20783078
## density             0.05440968 -0.58297499 -0.17655419 -0.06719265
## pH                  0.21741517  0.16191843 -0.45304319  0.41722469
## sulphates           0.29628830 -0.18696101  0.07006084  0.64133655
## alcohol             0.09418411  0.46646648  0.26397977  0.11655642
##                           PC5         PC6         PC7           PC8
## fixedacidity        0.1547602  0.20364057  0.27971559 -0.3963022602
## volatileacidity    -0.1560440  0.49104757  0.39095268  0.0720670986
## citricacid          0.1497985 -0.22550146  0.38244529  0.2879511173
## residualsugar       0.3459300  0.24730219 -0.21431881  0.5319252460
## chlorides          -0.6196015 -0.16073700  0.05007998  0.4690672718
## freesulfurdioxide  -0.2275352  0.32825130  0.29793827 -0.2221646385
## totalsulfurdioxide -0.1602445  0.14420465  0.13874114 -0.1357970250
## density             0.3062889 -0.01424526  0.04784695  0.0009818868
## pH                  0.4558231 -0.29275459  0.41678462  0.0378994953
## sulphates           0.1291003  0.29372378 -0.52732734 -0.1688302664
## alcohol             0.1731511  0.52804489  0.11009560  0.3925907281
##                            PC9         PC10         PC11
## fixedacidity       -0.34687946  0.277654103  0.341651503
## volatileacidity     0.50031121 -0.149836074  0.079676500
## citricacid          0.40781678 -0.233092669 -0.005579421
## residualsugar      -0.09717103 -0.007398810  0.446188821
## chlorides          -0.29455744  0.191584862  0.049801574
## freesulfurdioxide  -0.36234369 -0.483988851  0.002484427
## totalsulfurdioxide  0.31411739  0.716601945 -0.057705317
## density            -0.11811012  0.008526929 -0.714957824
## pH                 -0.12636044  0.137903305  0.208754539
## sulphates           0.20903186 -0.044780650  0.076287477
## alcohol            -0.25153240  0.201262921 -0.333812989

plot(prcomp(v, scale = T))

summary(prcomp(v, scale = T))

## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6
## Standard deviation     1.7412 1.5791 1.2464 0.98545 0.84537 0.77894
## Proportion of Variance 0.2756 0.2267 0.1412 0.08828 0.06497 0.05516
## Cumulative Proportion  0.2756 0.5023 0.6435 0.73181 0.79678 0.85194
##                            PC7     PC8    PC9    PC10    PC11
## Standard deviation     0.72356 0.70943 0.5821 0.47810 0.18564
## Proportion of Variance 0.04759 0.04575 0.0308 0.02078 0.00313
## Cumulative Proportion  0.89953 0.94528 0.9761 0.99687 1.00000

biplot(prcomp(v, scale = TRUE))

Descobertas:

A variação proporcional encontrada pelo PCA no seu melhor componente é muito baixa. PC1 explica cerca de 27% da variância total. Baseado nisso não teremos grandes vantagens em adicionar esses componetes ao modelo.
Podemos ver também basedo na Rotation que temos features com correlações muito fortes como: freesulfurdioxide e totalsulfurdioxide, também fixedacidity e volatileacidity, que já havíamos identificado em outras partes da análise e podem ser candidatas para utilizar apenas uma delas.

Etapa 1 - Outliers

v <- Vinhos %>% select(c(fixedacidity,volatileacidity,citricacid,residualsugar,
chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,sulphates,alcohol))

v <- rm.outlier(v, fill = T, median = T, opposite = FALSE)
vw <- rm.outlier(vw, fill = T, median = T, opposite = FALSE)

Descobertas:

Como sabemos que os modelos de regressão são muito sensíveis a outliers nós iremos removê-los e preenchê-los com a mediana.
Decidimos por não remover a observação inteira para não prejudicar o número de observações totais de determinadas notas de qualidade.

Etapa 1 - Conclusão

Qual a opção seguirá sobre os tipos de vinhos?

Criaremos modelos separados para a tarefa de regressão e classificação da feature Quality, porque existem um número relativamente maior de observações de WHITE em relação a RED. Isso indica que podemos acabar gerando um modelo mais acertivo para vinhos brancos e nem tanto para vinhos vermelhos, esse desbalanço do dataset pode fazer com que as características dos dois tipos não apareçam no modelo. Porém gostaríamos de comprovar a ideia na parte do treinamento do modelo.

Qual estratégia sobre os outliers?

Substituir outliers com a mediana, mantendo a informação porém evitando prejudicar os modelos de regressão.

Vai utilizar PCA? Justifique

Não, os componentes gerados apresentaram uma variação proporcional muito baixa, e não vemos vantagens em utilizá-los.

Etapa 2 - Preparação para dados de treino e teste

A seguir definiremos 2/3 da base de vinhos brancos para treino, e 1/3 para teste

prt <- 2/3
set.seed(666)
treino <- sample(1:nrow(vw), as.integer(prt*nrow(vw)))
dataTreino <- vw[treino,]
dataTeste <- vw[-treino,]

Validando a consistência de qualidade entre as bases de treino e teste

prop.table(table(dataTreino$quality))

## 
##           3           4           5           6           7           8 
## 0.003675345 0.033384380 0.297396631 0.446554364 0.182235835 0.036753446

prop.table(table(dataTeste$quality))

## 
##           3           4           5           6           7           8 
## 0.004898959 0.033067973 0.297611758 0.456215554 0.174525413 0.033680343

Descobertas: - As proporções estão razoavelmente bem distribuídas entre as notas de qualidade. Isso leva a ter um bom treino para o modelo

Etapa 2 - Regressão variável Quality

Etapa 2 - Regressão Linear

Realizando a regressão linear com todas as variáveis

x <- lm(quality~fixedacidity+volatileacidity+citricacid+residualsugar+chlorides+freesulfurdioxide+totalsulfurdioxide+density+pH+sulphates+alcohol, data=dataTreino)

Analisando o summary

summary(x)

## 
## Call:
## lm(formula = quality ~ fixedacidity + volatileacidity + citricacid + 
##     residualsugar + chlorides + freesulfurdioxide + totalsulfurdioxide + 
##     density + pH + sulphates + alcohol, data = dataTreino)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.2254 -0.5019 -0.0524  0.4610  2.8019 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         2.163e+02  2.696e+01   8.023 1.43e-15 ***
## fixedacidity        1.332e-01  2.780e-02   4.790 1.75e-06 ***
## volatileacidity    -1.819e+00  1.341e-01 -13.565  < 2e-16 ***
## citricacid          1.051e-01  1.185e-01   0.887  0.37495    
## residualsugar       1.007e-01  1.023e-02   9.841  < 2e-16 ***
## chlorides           3.834e-01  6.868e-01   0.558  0.57666    
## freesulfurdioxide   4.908e-03  1.059e-03   4.633 3.75e-06 ***
## totalsulfurdioxide -2.991e-04  4.658e-04  -0.642  0.52086    
## density            -2.177e+02  2.733e+01  -7.967 2.23e-15 ***
## pH                  9.934e-01  1.354e-01   7.335 2.78e-13 ***
## sulphates           6.517e-01  1.208e-01   5.396 7.30e-08 ***
## alcohol             1.213e-01  3.418e-02   3.551  0.00039 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7379 on 3253 degrees of freedom
## Multiple R-squared:  0.3037, Adjusted R-squared:  0.3013 
## F-statistic:   129 on 11 and 3253 DF,  p-value: < 2.2e-16

Descobertas:

Algumas variáveis estão sendo consideradas, mas possuem baixo nível de significância, portanto podemos eliminá-las

Eliminando variáveis não significativas

stepwise <- step(x,direction="both")

## Start:  AIC=-1973.23
## quality ~ fixedacidity + volatileacidity + citricacid + residualsugar + 
##     chlorides + freesulfurdioxide + totalsulfurdioxide + density + 
##     pH + sulphates + alcohol
## 
##                      Df Sum of Sq    RSS     AIC
## - chlorides           1     0.170 1771.2 -1974.9
## - totalsulfurdioxide  1     0.224 1771.2 -1974.8
## - citricacid          1     0.429 1771.4 -1974.4
## <none>                            1771.0 -1973.2
## - alcohol             1     6.864 1777.9 -1962.6
## - freesulfurdioxide   1    11.685 1782.7 -1953.8
## - fixedacidity        1    12.489 1783.5 -1952.3
## - sulphates           1    15.853 1786.9 -1946.1
## - pH                  1    29.295 1800.3 -1921.7
## - density             1    34.555 1805.6 -1912.1
## - residualsugar       1    52.726 1823.7 -1879.4
## - volatileacidity     1   100.183 1871.2 -1795.6
## 
## Step:  AIC=-1974.91
## quality ~ fixedacidity + volatileacidity + citricacid + residualsugar + 
##     freesulfurdioxide + totalsulfurdioxide + density + pH + sulphates + 
##     alcohol
## 
##                      Df Sum of Sq    RSS     AIC
## - totalsulfurdioxide  1     0.225 1771.4 -1976.5
## - citricacid          1     0.530 1771.7 -1975.9
## <none>                            1771.2 -1974.9
## + chlorides           1     0.170 1771.0 -1973.2
## - alcohol             1     6.877 1778.1 -1964.3
## - freesulfurdioxide   1    11.747 1782.9 -1955.3
## - fixedacidity        1    12.377 1783.6 -1954.2
## - sulphates           1    15.735 1786.9 -1948.0
## - pH                  1    29.387 1800.6 -1923.2
## - density             1    34.677 1805.9 -1913.6
## - residualsugar       1    53.623 1824.8 -1879.5
## - volatileacidity     1   100.344 1871.5 -1797.0
## 
## Step:  AIC=-1976.5
## quality ~ fixedacidity + volatileacidity + citricacid + residualsugar + 
##     freesulfurdioxide + density + pH + sulphates + alcohol
## 
##                      Df Sum of Sq    RSS     AIC
## - citricacid          1     0.507 1771.9 -1977.6
## <none>                            1771.4 -1976.5
## + totalsulfurdioxide  1     0.225 1771.2 -1974.9
## + chlorides           1     0.170 1771.2 -1974.8
## - alcohol             1     6.684 1778.1 -1966.2
## - fixedacidity        1    12.795 1784.2 -1955.0
## - freesulfurdioxide   1    15.593 1787.0 -1949.9
## - sulphates           1    15.599 1787.0 -1949.9
## - pH                  1    29.875 1801.3 -1923.9
## - density             1    38.465 1809.9 -1908.4
## - residualsugar       1    57.075 1828.5 -1875.0
## - volatileacidity     1   107.007 1878.4 -1787.0
## 
## Step:  AIC=-1977.56
## quality ~ fixedacidity + volatileacidity + residualsugar + freesulfurdioxide + 
##     density + pH + sulphates + alcohol
## 
##                      Df Sum of Sq    RSS     AIC
## <none>                            1771.9 -1977.6
## + citricacid          1     0.507 1771.4 -1976.5
## + chlorides           1     0.269 1771.7 -1976.1
## + totalsulfurdioxide  1     0.202 1771.7 -1975.9
## - alcohol             1     7.039 1779.0 -1966.6
## - fixedacidity        1    13.390 1785.3 -1955.0
## - sulphates           1    15.937 1787.8 -1950.3
## - freesulfurdioxide   1    16.212 1788.1 -1949.8
## - pH                  1    29.391 1801.3 -1925.8
## - density             1    37.987 1809.9 -1910.3
## - residualsugar       1    56.589 1828.5 -1876.9
## - volatileacidity     1   112.459 1884.4 -1778.7

y <- lm(quality ~ fixedacidity + volatileacidity + residualsugar + freesulfurdioxide + density + pH + sulphates + alcohol, data=dataTreino)

summary(y)

## 
## Call:
## lm(formula = quality ~ fixedacidity + volatileacidity + residualsugar + 
##     freesulfurdioxide + density + pH + sulphates + alcohol, data = dataTreino)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.2194 -0.4993 -0.0511  0.4599  2.7910 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        2.161e+02  2.569e+01   8.411  < 2e-16 ***
## fixedacidity       1.344e-01  2.709e-02   4.960 7.40e-07 ***
## volatileacidity   -1.851e+00  1.287e-01 -14.375  < 2e-16 ***
## residualsugar      1.001e-01  9.814e-03  10.197  < 2e-16 ***
## freesulfurdioxide  4.579e-03  8.388e-04   5.458 5.18e-08 ***
## density           -2.174e+02  2.602e+01  -8.355  < 2e-16 ***
## pH                 9.732e-01  1.324e-01   7.349 2.51e-13 ***
## sulphates          6.512e-01  1.203e-01   5.412 6.70e-08 ***
## alcohol            1.217e-01  3.383e-02   3.596 0.000327 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7377 on 3256 degrees of freedom
## Multiple R-squared:  0.3033, Adjusted R-squared:  0.3016 
## F-statistic: 177.2 on 8 and 3256 DF,  p-value: < 2.2e-16

pred1 <- predict(y, newdata = dataTeste)
RMSE(pred = pred1, obs = dataTeste$quality)

## [1] 0.7623217

Descobertas:

Identificamos que o p-value é menor que 5% então podemos rejeitar a hipótese nula
Outro fator é que o R-squared é de 30, o que significa que a regressão linear não descreve o modelo com tanta precisão

Conclusão:

O modelo criado através da técnica de regressão linear não descreve muito bem a nota de qualidade dos vinhos, com uma acertividade de aproximadamente 30%
Não será necessário fazer o modelo de predição, devido ao baixo índice de acertividade

Etapa 2 - Árvore de regressão

Basicamente a árvore de regressão particiona o dataset em subgrupos menores e então estabelece um constante simples para cada observação daquele subgrupo. O particionamento é alcançado através de sucessivas partições binárias, também conhecido como particionamento binário recursivo, baseado nas diferentes características. A constante a ser prevista é baseado na média da resposta dos valores de todas as observações que caem naquele subgrupo.

As árvores de decisão tendem ao overfitting então é necessário fazer um fine tunning com alguns hyperparametros para ajusta-las, como por exemplo o numero máximo de galhos em um nó e o numero mínimo de observações que uma folha pode conter.

A variável target é a quality e as variáveis que utilizaremos para prever o seu valor são: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, density, pH,sulphates,alcohol.

Etapa 2 - Árvore de regressão - Dataset sem modificações

v <- Vinhos %>% select(c(fixedacidity,volatileacidity,citricacid,residualsugar,
chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,sulphates,alcohol))

set.seed(123)
sample <- sample.split(Vinhos$quality, SplitRatio = .70)
v_train <- subset(Vinhos, sample == TRUE)
v_test  <- subset(Vinhos, sample == FALSE)

# Árvore de regressão sem fine tuning
m1 <- rpart(
  formula = quality ~ .,
  data    = v_train,
  method  = "anova"
  )

pred1 <- predict(m1, newdata = v_test)
RMSE(pred = pred1, obs = v_test$quality)

## [1] 0.7624472

rpart.plot(m1)

plotcp(m1)

Bagging

set.seed(123)
# Árvore de regressão usando bagging
m2 <- bagging(
  formula = quality ~ .,
  data    = v_train,
  coob    = TRUE
)

# get OOB error
m2$err

## [1] 0.7441564

# predicion error
pred2 <- predict(m2, newdata = v_test)
RMSE(pred = pred2, obs = v_test$quality)

## [1] 0.7389704

Árvore de regressão usando bagging e 10-fold cross validation

set.seed(123)
# Specify 10-fold cross validation
ctrl <- trainControl(method = "cv",  number = 10) 

# CV bagged model
m3 <- train(
  quality ~ .,
  data = v_train,
  method = "treebag",
  trControl = ctrl,
  importance = TRUE
)

# assess results
m3

## Bagged CART 
## 
## 4548 samples
##   12 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 4093, 4094, 4093, 4093, 4093, 4093, ... 
## Resampling results:
## 
##   RMSE       Rsquared   MAE      
##   0.7426551  0.2798523  0.5878768

pred3 <- predict(m3, newdata = v_test)
RMSE(pred = pred3, obs = v_test$quality)

## [1] 0.7412857

plot most important variables

plot(varImp(m3), 20)

Etapa 2 - Árvore de regressão - Dataset sem outliers

v <- Vinhos %>% select(c(fixedacidity,volatileacidity,citricacid,residualsugar,
chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,sulphates,alcohol))

v <- rm.outlier(v, fill = T, median = T, opposite = FALSE)

v %>% mutate(quality = quality) -> v

head(v)

##   fixedacidity volatileacidity citricacid residualsugar chlorides
## 1          6.6            0.24       0.35          7.70     0.031
## 2          6.7            0.34       0.43          1.60     0.041
## 3         10.6            0.31       0.49          2.20     0.063
## 4          5.4            0.18       0.24          4.80     0.041
## 5          6.7            0.30       0.44         18.75     0.057
## 6          6.8            0.50       0.11          1.50     0.075
##   freesulfurdioxide totalsulfurdioxide density   pH sulphates alcohol
## 1                36                135 0.99380 3.19      0.37    10.5
## 2                29                114 0.99014 3.23      0.44    12.6
## 3                18                 40 0.99760 3.14      0.51     9.8
## 4                30                113 0.99445 3.42      0.40     9.4
## 5                65                224 0.99956 3.11      0.53     9.1
## 6                16                 49 0.99545 3.36      0.79     9.5
##   quality
## 1       5
## 2       6
## 3       6
## 4       6
## 5       5
## 6       5

set.seed(123)
sample <- sample.split(v$quality, SplitRatio = .70)
v_train <- subset(v, sample == TRUE)
v_test  <- subset(v, sample == FALSE)

# Árvore de regressão sem fine tuning
m1 <- rpart(
  formula = quality ~ .,
  data    = v_train,
  method  = "anova"
  )

pred1 <- predict(m1, newdata = v_test)
RMSE(pred = pred1, obs = v_test$quality)

## [1] 0.7607358

melhorou um pouco tirando os outliers

rpart.plot(m1)

plotcp(m1)

Bagging

set.seed(123)
# Árvore de regressão usando bagging
m2 <- bagging(
  formula = quality ~ .,
  data    = v_train,
  coob    = TRUE
)

# get OOB error
m2$err

## [1] 0.7444525

# predicion error
pred2 <- predict(m2, newdata = v_test)
RMSE(pred = pred2, obs = v_test$quality)

## [1] 0.73926

Árvore de regressão usando bagging e 10-fold cross validation

set.seed(123)
# Specify 10-fold cross validation
ctrl <- trainControl(method = "cv",  number = 10) 

# CV bagged model
m3 <- train(
  quality ~ .,
  data = v_train,
  method = "treebag",
  trControl = ctrl,
  importance = TRUE
)

# assess results
m3

## Bagged CART 
## 
## 4548 samples
##   11 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 4093, 4094, 4093, 4093, 4093, 4093, ... 
## Resampling results:
## 
##   RMSE       Rsquared   MAE     
##   0.7430463  0.2790741  0.588015

pred3 <- predict(m3, newdata = v_test)
RMSE(pred = pred3, obs = v_test$quality)

## [1] 0.7415393

plot(varImp(m3), 20)

Etapa 2 - Árvore de regressão - Dataset sem outliers e apenas vinhos do tipo WHITE

v <- Vinhos %>% 
  filter(Vinho == 'WHITE') %>%
  select(c(fixedacidity,volatileacidity,citricacid,residualsugar,
chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,sulphates,alcohol))

v <- rm.outlier(v, fill = T, median = T, opposite = FALSE)

whiteQuality <- Vinhos %>%
  filter(Vinho == 'WHITE') %>%
  select(c(quality))

v %>% mutate(quality = whiteQuality$quality ) -> v

head(v)

##   fixedacidity volatileacidity citricacid residualsugar chlorides
## 1          6.6            0.24       0.35          7.70     0.031
## 2          6.7            0.34       0.43          1.60     0.041
## 3          5.4            0.18       0.24          4.80     0.041
## 4          6.7            0.30       0.44         18.75     0.057
## 5          5.1            0.26       0.33          1.10     0.027
## 6          6.2            0.22       0.20         20.80     0.035
##   freesulfurdioxide totalsulfurdioxide density   pH sulphates alcohol
## 1                36                135 0.99380 3.19      0.37    10.5
## 2                29                114 0.99014 3.23      0.44    12.6
## 3                30                113 0.99445 3.42      0.40     9.4
## 4                65                224 0.99956 3.11      0.53     9.1
## 5                46                113 0.98946 3.35      0.43    11.4
## 6                58                184 1.00022 3.11      0.53     9.0
##   quality
## 1       5
## 2       6
## 3       6
## 4       5
## 5       7
## 6       6

set.seed(123)
sample <- sample.split(v$quality, SplitRatio = .70)
v_train <- subset(v, sample == TRUE)
v_test  <- subset(v, sample == FALSE)

# Árvore de regressão sem fine tuning
m1 <- rpart(
  formula = quality ~ .,
  data    = v_train,
  method  = "anova"
  )

pred1 <- predict(m1, newdata = v_test)
RMSE(pred = pred1, obs = v_test$quality)

## [1] 0.7724475

rpart.plot(m1)

plotcp(m1)

Bagging

set.seed(123)
# Árvore de regressão usando bagging
m2 <- bagging(
  formula = quality ~ .,
  data    = v_train,
  coob    = TRUE
)

# get OOB error
m2$err

## [1] 0.7418527

# predicion error
pred2 <- predict(m2, newdata = v_test)
RMSE(pred = pred2, obs = v_test$quality)

## [1] 0.7523468

Árvore de regressão usando bagging e 10-fold cross validation

set.seed(123)
# Specify 10-fold cross validation
ctrl <- trainControl(method = "cv",  number = 10) 

# CV bagged model
m3 <- train(
  quality ~ .,
  data = v_train,
  method = "treebag",
  trControl = ctrl,
  importance = TRUE
)

# assess results
m3

## Bagged CART 
## 
## 3429 samples
##   11 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 3085, 3086, 3087, 3086, 3086, 3087, ... 
## Resampling results:
## 
##   RMSE       Rsquared   MAE      
##   0.7392487  0.3046547  0.5846012

pred3 <- predict(m3, newdata = v_test)
RMSE(pred = pred3, obs = v_test$quality)

## [1] 0.7534588

plot(varImp(m3), 20)

Etapa 2 - Árvore de regressão - Dataset sem outliers e apenas vinhos do tipo RED

v <- Vinhos %>% 
  filter(Vinho == 'RED') %>%
  select(c(fixedacidity,volatileacidity,citricacid,residualsugar,
chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,sulphates,alcohol))

v <- rm.outlier(v, fill = T, median = T, opposite = FALSE)

redQuality <- Vinhos %>%
  filter(Vinho == 'RED') %>%
  select(c(quality))

v %>% mutate(quality = redQuality$quality ) -> v

head(v)

##   fixedacidity volatileacidity citricacid residualsugar chlorides
## 1         10.6           0.310       0.49           2.2     0.063
## 2          6.8           0.500       0.11           1.5     0.075
## 3          6.6           0.610       0.00           1.6     0.069
## 4          7.2           0.660       0.33           2.5     0.068
## 5          7.2           0.630       0.00           1.9     0.097
## 6          7.1           0.735       0.16           1.9     0.100
##   freesulfurdioxide totalsulfurdioxide density   pH sulphates alcohol
## 1                18                 40 0.99760 3.14      0.51     9.8
## 2                16                 49 0.99545 3.36      0.79     9.5
## 3                 4                  8 0.99396 3.33      0.37    10.4
## 4                34                102 0.99414 3.27      0.78    12.8
## 5                14                 38 0.99675 3.37      0.58     9.0
## 6                15                 77 0.99660 3.27      0.64     9.3
##   quality
## 1       6
## 2       5
## 3       4
## 4       6
## 5       6
## 6       5

set.seed(123)
sample <- sample.split(v$quality, SplitRatio = .70)
v_train <- subset(v, sample == TRUE)
v_test  <- subset(v, sample == FALSE)

# Árvore de regressão sem fine tuning
m1 <- rpart(
  formula = quality ~ .,
  data    = v_train,
  method  = "anova"
  )

pred1 <- predict(m1, newdata = v_test)
RMSE(pred = pred1, obs = v_test$quality)

## [1] 0.6611792

rpart.plot(m1)

plotcp(m1)

Bagging

set.seed(123)
# Árvore de regressão usando bagging
m2 <- bagging(
  formula = quality ~ .,
  data    = v_train,
  coob    = TRUE
)

# get OOB error
m2$err

## [1] 0.6368096

# predicion error
pred2 <- predict(m2, newdata = v_test)
RMSE(pred = pred2, obs = v_test$quality)

## [1] 0.6350595

Árvore de regressão usando bagging e 10-fold cross validation

set.seed(123)
# Specify 10-fold cross validation
ctrl <- trainControl(method = "cv",  number = 10) 

# CV bagged model
m3 <- train(
  quality ~ .,
  data = v_train,
  method = "treebag",
  trControl = ctrl,
  importance = TRUE
)

# assess results
m3

## Bagged CART 
## 
## 1120 samples
##   11 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 1008, 1009, 1009, 1007, 1007, 1008, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE      
##   0.626993  0.4015921  0.4892482

pred3 <- predict(m3, newdata = v_test)
RMSE(pred = pred3, obs = v_test$quality)

## [1] 0.6412619

plot(varImp(m3), 20)

Etapa 2 - Árvore de regressão - Resumo dos resultados finais

x <- data.frame(
  "sem fine tuning" = c(0.7624472, 0.7607358, 0.7724475, 0.6611792), 
  "bagging" = c(0.7389704,0.73926, 0.7523468, 0.6350595), 
  "bagging 10k fold cross validation" = c(0.7412857, 0.7415393, 0.7534588, 0.6412619)
  )
rownames(x) <- c("Sem Modificação", "Sem outliers", "Apenas com WHITE", "Apenas com RED")
x

##                  sem.fine.tuning   bagging
## Sem Modificação        0.7624472 0.7389704
## Sem outliers           0.7607358 0.7392600
## Apenas com WHITE       0.7724475 0.7523468
## Apenas com RED         0.6611792 0.6350595
##                  bagging.10k.fold.cross.validation
## Sem Modificação                          0.7412857
## Sem outliers                             0.7415393
## Apenas com WHITE                         0.7534588
## Apenas com RED                           0.6412619

Descobertas:

A tirada dos outliers não representou uma melhoria signficativa na performance do modelo
Utilizar técnicas de bagging (combinação de vários modelos) ajudour de forma significativa na performance do modelo e no controle do overfitting
Treinar um modelo específico para prever RED parece trazer resultados melhores, conseguimos perceber que existe diferentes notáveis entre os dois tipos e que as variáveis relevantes para explicar RED são diferentes para WHITE.
Um modelo treinado exclusivamente para WHITE acabou gerando um resultado pior do que treinar um modelo para o dataset inteiro.

Etapa 2 - Comparação entre modelos

Identificamos que as técnicas de árvore de regressão se sairam melhor descrevendo esse dataset.

Etapa 3 - Classificação com variável Quality: Vinhos bons e ruins

Etapa 3 - Árvore de decisão

v <- Vinhos %>%
  mutate(aboveAverage = quality >= 7.0 )

v$aboveAverage <- as.factor(v$aboveAverage)

v <- v %>% select(c(fixedacidity,volatileacidity,citricacid,residualsugar,
chlorides,freesulfurdioxide,totalsulfurdioxide,density,pH,sulphates,alcohol, aboveAverage))

set.seed(123)
sample <- sample.split(v$aboveAverage, SplitRatio = .70)
v_train <- subset(v, sample == TRUE)
v_test  <- subset(v, sample == FALSE)

# Árvore de regressão sem fine tuning
model.tree <- rpart(
  formula = aboveAverage ~ .,
  data    = v_train
  )

pred.tree <- predict(model.tree, v_test, type = 'class')
xlab <- table(actualclass=v_test$aboveAverage,predictedclass=pred.tree)
confusionMatrix(xlab)

## Confusion Matrix and Statistics
## 
##            predictedclass
## actualclass FALSE TRUE
##       FALSE  1468   98
##       TRUE    261  122
##                                           
##                Accuracy : 0.8158          
##                  95% CI : (0.7979, 0.8328)
##     No Information Rate : 0.8871          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.305           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.8490          
##             Specificity : 0.5545          
##          Pos Pred Value : 0.9374          
##          Neg Pred Value : 0.3185          
##              Prevalence : 0.8871          
##          Detection Rate : 0.7532          
##    Detection Prevalence : 0.8035          
##       Balanced Accuracy : 0.7018          
##                                           
##        'Positive' Class : FALSE           
##

#Obtendo probabilidades da base de test
probs.tree <- predict(model.tree, newdata=v_test, type="prob")

#Calculando curva ROC
rocCurve.tree <- roc(v_test$aboveAverage, probs.tree[,"TRUE"])

#plot curva ROC
plot(rocCurve.tree, col=c(3))

#calculando a area abaixo da curva (quanto maior melhor)
auc(rocCurve.tree)

## Area under the curve: 0.7401

Bagging

set.seed(123)
# Árvore de regressão usando bagging
model.bagging <- bagging(
  formula = aboveAverage ~ .,
  data    = v_train,
  coob    = TRUE
)

pred.bagging <- predict(model.bagging, v_test, type = 'class')
xlab <- table(actualclass=v_test$aboveAverage,predictedclass=pred.bagging)
confusionMatrix(xlab)

## Confusion Matrix and Statistics
## 
##            predictedclass
## actualclass FALSE TRUE
##       FALSE  1476   90
##       TRUE    150  233
##                                           
##                Accuracy : 0.8769          
##                  95% CI : (0.8614, 0.8911)
##     No Information Rate : 0.8343          
##     P-Value [Acc > NIR] : 9.276e-08       
##                                           
##                   Kappa : 0.5855          
##  Mcnemar's Test P-Value : 0.0001398       
##                                           
##             Sensitivity : 0.9077          
##             Specificity : 0.7214          
##          Pos Pred Value : 0.9425          
##          Neg Pred Value : 0.6084          
##              Prevalence : 0.8343          
##          Detection Rate : 0.7573          
##    Detection Prevalence : 0.8035          
##       Balanced Accuracy : 0.8146          
##                                           
##        'Positive' Class : FALSE           
##

#Obtendo probabilidades da base de test
probs.bagging <- predict(model.bagging, newdata=v_test, type="prob")

#Calculando curva ROC
rocCurve.bagging <- roc(v_test$aboveAverage, probs.bagging[,"TRUE"])

#plot curva ROC
plot(rocCurve.bagging, col=c(3))

#calculando a area abaixo da curva (quanto maior melhor)
auc(rocCurve.bagging)

## Area under the curve: 0.8995

Bagging e 10-fold cross validation

set.seed(123)
# Specify 10-fold cross validation
ctrl <- trainControl(method = "repeatedcv",  number = 10, allowParallel=TRUE) 

# CV bagged model
model.treebag <- train(
  as.factor(aboveAverage) ~ .,
  data = v_train,
  method = "treebag",
  trControl = ctrl,
  importance=TRUE
)

# assess results
pred.treebag <- predict(model.treebag, v_test, type = 'raw')
xlab <- table(actualclass=v_test$aboveAverage,predictedclass=pred.treebag)
confusionMatrix(xlab)

## Confusion Matrix and Statistics
## 
##            predictedclass
## actualclass FALSE TRUE
##       FALSE  1481   85
##       TRUE    158  225
##                                           
##                Accuracy : 0.8753          
##                  95% CI : (0.8598, 0.8897)
##     No Information Rate : 0.8409          
##     P-Value [Acc > NIR] : 1.099e-05       
##                                           
##                   Kappa : 0.5746          
##  Mcnemar's Test P-Value : 3.860e-06       
##                                           
##             Sensitivity : 0.9036          
##             Specificity : 0.7258          
##          Pos Pred Value : 0.9457          
##          Neg Pred Value : 0.5875          
##              Prevalence : 0.8409          
##          Detection Rate : 0.7599          
##    Detection Prevalence : 0.8035          
##       Balanced Accuracy : 0.8147          
##                                           
##        'Positive' Class : FALSE           
##

#Obtendo probabilidades da base de test
probs.treebag <- predict(model.treebag, newdata=v_test, type="prob")

#Calculando curva ROC
rocCurve.treebag <- roc(v_test$aboveAverage, probs.treebag[,"TRUE"])

#plot curva ROC
plot(rocCurve.treebag, col=c(3))

#calculando a area abaixo da curva (quanto maior melhor)
auc(rocCurve.treebag)

## Area under the curve: 0.8932

Random Forest

set.seed(123)
# Specify 10-fold cross validation
ctrl <- trainControl(method = "repeatedcv",  number = 10, allowParallel=TRUE) 

# CV bagged model
model.rf <- train(
  as.factor(aboveAverage) ~ .,
  data = v_train,
  method = "rf",
  trControl = ctrl,
  importance=TRUE
)

# assess results
pred.rf <- predict(model.rf, v_test, type = 'raw')
xlab <- table(actualclass=v_test$aboveAverage,predictedclass=pred.rf)
confusionMatrix(xlab)

## Confusion Matrix and Statistics
## 
##            predictedclass
## actualclass FALSE TRUE
##       FALSE  1496   70
##       TRUE    151  232
##                                           
##                Accuracy : 0.8866          
##                  95% CI : (0.8717, 0.9004)
##     No Information Rate : 0.845           
##     P-Value [Acc > NIR] : 8.024e-08       
##                                           
##                   Kappa : 0.6098          
##  Mcnemar's Test P-Value : 7.392e-08       
##                                           
##             Sensitivity : 0.9083          
##             Specificity : 0.7682          
##          Pos Pred Value : 0.9553          
##          Neg Pred Value : 0.6057          
##              Prevalence : 0.8450          
##          Detection Rate : 0.7676          
##    Detection Prevalence : 0.8035          
##       Balanced Accuracy : 0.8383          
##                                           
##        'Positive' Class : FALSE           
##

#Obtendo probabilidades da base de test
probs.rf <- predict(model.rf, newdata=v_test, type="prob")

#Calculando curva ROC
rocCurve.rf <- roc(v_test$aboveAverage, probs.rf[,"TRUE"])

#plot curva ROC
plot(rocCurve.rf, col=c(3))

#calculando a area abaixo da curva (quanto maior melhor)
auc(rocCurve.rf)

## Area under the curve: 0.9067

Random Forest with boosting

set.seed(123)
# Specify 10-fold cross validation
ctrl <- trainControl(method = "repeatedcv",  number = 10, allowParallel=TRUE) 

# CV bagged model
model.gbm <- train(
  as.factor(aboveAverage) ~ .,
  data = v_train,
  verbose=F,
  method = "gbm",
  trControl = ctrl
)

# assess results
pred.gbm <- predict(model.gbm, v_test, type = 'raw')
xlab <- table(actualclass=v_test$aboveAverage,predictedclass=pred.gbm)
confusionMatrix(xlab)

## Confusion Matrix and Statistics
## 
##            predictedclass
## actualclass FALSE TRUE
##       FALSE  1475   91
##       TRUE    225  158
##                                          
##                Accuracy : 0.8379         
##                  95% CI : (0.8207, 0.854)
##     No Information Rate : 0.8722         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.4084         
##  Mcnemar's Test P-Value : 7.329e-14      
##                                          
##             Sensitivity : 0.8676         
##             Specificity : 0.6345         
##          Pos Pred Value : 0.9419         
##          Neg Pred Value : 0.4125         
##              Prevalence : 0.8722         
##          Detection Rate : 0.7568         
##    Detection Prevalence : 0.8035         
##       Balanced Accuracy : 0.7511         
##                                          
##        'Positive' Class : FALSE          
##

#Obtendo probabilidades da base de test
probs.gbm <- predict(model.gbm, newdata=v_test, type="prob")

#Calculando curva ROC
rocCurve.gbm <- roc(v_test$aboveAverage, probs.gbm[,"TRUE"])

#plot curva ROC
plot(rocCurve.gbm, col=c(3))

#calculando a area abaixo da curva (quanto maior melhor)
auc(rocCurve.gbm)

## Area under the curve: 0.8617

Analisando todas as curvas ROC dos modelos gerados

plot(rocCurve.tree,col=c(4)) # color blue is simple tree
plot(rocCurve.bagging ,add=TRUE,col=c(6)) # color magenta is bagging
plot(rocCurve.treebag ,add=TRUE,col=c(2)) # color red is treebag
plot(rocCurve.rf,add=TRUE,col=c(1)) # color black is rf
plot(rocCurve.gbm,add=TRUE,col=c(3)) # color green is gbm

Descobertas:

O RandomForest foi o melhor modelo entre todas as técnicas de árvores de decisão testadas, mostrando a melhor curva ROC o que indica que o modelo tem um boa generalização e a maior taxa de acurácia. Acurácia 0.8866, área sob a curva ROC 0.9067

Etapa 3 - Regressão Logística

Para gerar um modelo de regressão logística, primeiro devemos categorizar a variável target “quality” Definimos uma nova variável categórica (qualidade) com notas iguais ou acima de 7 sendo um vinho bom (1), e abaixo sendo ruim (0)

notaCorte = 7
rldataTreino <- dataTreino
rldataTeste <- dataTeste
attach(rldataTreino)

## The following objects are masked from Vinhos:
## 
##     alcohol, chlorides, citricacid, density, fixedacidity,
##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
##     totalsulfurdioxide, volatileacidity

rldataTreino$qualidade <- ifelse(rldataTreino$quality >= notaCorte, 1,ifelse(rldataTreino$quality < notaCorte, 0,0))
rldataTeste$qualidade <- ifelse(rldataTeste$quality >= notaCorte, 1,ifelse(rldataTeste$quality < notaCorte, 0,0))

Realizando a regressão logística com todas as variáveis

x <- glm(qualidade~fixedacidity+volatileacidity+citricacid+residualsugar+chlorides+freesulfurdioxide+totalsulfurdioxide+density+pH+sulphates+alcohol, data=rldataTreino)

Analisando o summary

summary(x)

## 
## Call:
## glm(formula = qualidade ~ fixedacidity + volatileacidity + citricacid + 
##     residualsugar + chlorides + freesulfurdioxide + totalsulfurdioxide + 
##     density + pH + sulphates + alcohol, data = rldataTreino)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -0.67232  -0.24878  -0.09711   0.06004   1.07338  
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         8.746e+01  1.365e+01   6.409 1.67e-10 ***
## fixedacidity        6.943e-02  1.407e-02   4.934 8.45e-07 ***
## volatileacidity    -2.624e-01  6.788e-02  -3.866 0.000113 ***
## citricacid         -3.105e-03  5.996e-02  -0.052 0.958709    
## residualsugar       3.853e-02  5.178e-03   7.441 1.27e-13 ***
## chlorides          -1.514e-01  3.476e-01  -0.436 0.663124    
## freesulfurdioxide   1.426e-03  5.362e-04   2.659 0.007884 ** 
## totalsulfurdioxide -1.137e-04  2.358e-04  -0.482 0.629779    
## density            -9.036e+01  1.383e+01  -6.533 7.48e-11 ***
## pH                  4.303e-01  6.854e-02   6.278 3.90e-10 ***
## sulphates           2.974e-01  6.112e-02   4.865 1.20e-06 ***
## alcohol             3.641e-02  1.730e-02   2.105 0.035377 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.139463)
## 
##     Null deviance: 558.42  on 3264  degrees of freedom
## Residual deviance: 453.67  on 3253  degrees of freedom
## AIC: 2847.7
## 
## Number of Fisher Scoring iterations: 2

Descobertas:

Algumas variáveis estão sendo consideradas, mas possuem baixo nível de significância para o modelo, portanto podemos descartá-las

Descartando variáveis não significativas

stepwise <- step(x,direction="both")

## Start:  AIC=2847.74
## qualidade ~ fixedacidity + volatileacidity + citricacid + residualsugar + 
##     chlorides + freesulfurdioxide + totalsulfurdioxide + density + 
##     pH + sulphates + alcohol
## 
##                      Df Deviance    AIC
## - citricacid          1   453.67 2845.7
## - chlorides           1   453.70 2845.9
## - totalsulfurdioxide  1   453.71 2846.0
## <none>                    453.67 2847.7
## - alcohol             1   454.29 2850.2
## - freesulfurdioxide   1   454.66 2852.8
## - volatileacidity     1   455.76 2860.7
## - sulphates           1   456.97 2869.4
## - fixedacidity        1   457.07 2870.1
## - pH                  1   459.17 2885.1
## - density             1   459.62 2888.3
## - residualsugar       1   461.40 2900.8
## 
## Step:  AIC=2845.74
## qualidade ~ fixedacidity + volatileacidity + residualsugar + 
##     chlorides + freesulfurdioxide + totalsulfurdioxide + density + 
##     pH + sulphates + alcohol
## 
##                      Df Deviance    AIC
## - chlorides           1   453.70 2843.9
## - totalsulfurdioxide  1   453.71 2844.0
## <none>                    453.67 2845.7
## + citricacid          1   453.67 2847.7
## - alcohol             1   454.29 2848.2
## - freesulfurdioxide   1   454.66 2850.8
## - volatileacidity     1   455.82 2859.1
## - sulphates           1   456.98 2867.5
## - fixedacidity        1   457.11 2868.4
## - pH                  1   459.20 2883.3
## - density             1   459.64 2886.4
## - residualsugar       1   461.41 2898.9
## 
## Step:  AIC=2843.95
## qualidade ~ fixedacidity + volatileacidity + residualsugar + 
##     freesulfurdioxide + totalsulfurdioxide + density + pH + sulphates + 
##     alcohol
## 
##                      Df Deviance    AIC
## - totalsulfurdioxide  1   453.73 2842.2
## <none>                    453.70 2843.9
## + chlorides           1   453.67 2845.7
## + citricacid          1   453.70 2845.9
## - alcohol             1   454.32 2846.4
## - freesulfurdioxide   1   454.68 2849.0
## - volatileacidity     1   455.89 2857.7
## - sulphates           1   457.04 2865.9
## - fixedacidity        1   457.35 2868.1
## - pH                  1   459.57 2883.9
## - density             1   460.00 2886.9
## - residualsugar       1   461.97 2900.9
## 
## Step:  AIC=2842.18
## qualidade ~ fixedacidity + volatileacidity + residualsugar + 
##     freesulfurdioxide + density + pH + sulphates + alcohol
## 
##                      Df Deviance    AIC
## <none>                    453.73 2842.2
## + totalsulfurdioxide  1   453.70 2843.9
## + chlorides           1   453.71 2844.0
## + citricacid          1   453.73 2844.2
## - alcohol             1   454.32 2844.4
## - freesulfurdioxide   1   454.96 2849.0
## - volatileacidity     1   456.14 2857.4
## - sulphates           1   457.05 2863.9
## - fixedacidity        1   457.47 2867.0
## - pH                  1   459.70 2882.8
## - density             1   460.71 2890.0
## - residualsugar       1   462.55 2903.0

y <- lm(qualidade ~ fixedacidity + volatileacidity + residualsugar + freesulfurdioxide + density + pH + sulphates, data=rldataTreino, family = "binomial")

## Warning: In lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) :
##  extra argument 'family' will be disregarded

summary(y)

## 
## Call:
## lm(formula = qualidade ~ fixedacidity + volatileacidity + residualsugar + 
##     freesulfurdioxide + density + pH + sulphates, data = rldataTreino, 
##     family = "binomial")
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.68649 -0.25037 -0.09891  0.06131  1.07570 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        1.152e+02  4.565e+00  25.237  < 2e-16 ***
## fixedacidity       9.068e-02  9.820e-03   9.234  < 2e-16 ***
## volatileacidity   -2.482e-01  6.426e-02  -3.863 0.000114 ***
## residualsugar      4.812e-02  2.663e-03  18.068  < 2e-16 ***
## freesulfurdioxide  1.220e-03  4.243e-04   2.874 0.004074 ** 
## density           -1.184e+02  4.690e+00 -25.252  < 2e-16 ***
## pH                 5.249e-01  5.223e-02  10.049  < 2e-16 ***
## sulphates          3.349e-01  5.805e-02   5.769  8.7e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3735 on 3257 degrees of freedom
## Multiple R-squared:  0.1864, Adjusted R-squared:  0.1847 
## F-statistic: 106.6 on 7 and 3257 DF,  p-value: < 2.2e-16

Validando o ajuste do modelo

z <- predict(y, newdata=rldataTeste, type='response')
z <- ifelse(z > 0.5,1,0)
erro <- mean(z != rldataTeste$qualidade)
print(paste('Acurácia',1-erro))

## [1] "Acurácia 0.810165339865279"

Descobertas:

Executamos o predict da base de treino versus a base de teste, e descobrimos que o modelo gerado está com um índice de acertividade de aproximadamente 81%

Conclusão:

O modelo criado através de regressão logística multivariada em família binomial, é adequado para classificar os vinhos brancos bons, com notas iguais ou acima de 7, de acordo com a base de dados fornecida.

Etapa 3 - Comparação dos modelos

Baseado nas métricas de acurácia e área sob a curva ROC podemos chegar a conclusão que a técnica Random Forest (árvore de decisão) obteve melhores resultados nesse dataset.

Etapa 4 - Análise sobre outras possíveis técnicas

Etapa 4 - Outras técnicas supervisionadas

quais outras técnicas supervisionadas vocês indicariam como adequadas para esta análise?

Etapa 4 - Técnicas não supervisionadas

Como técnica não supervisionada, vamos testar se o algoritmo de clusterização será adequado para agrupar dois conjunto de vinhos, categorizando-os como vinhos bons e vinhos ruins.

A variável ‘quality’, que identifica a nota do vinho, será a variável utilizada para correlacionar com as demais variáveis para identificar se existe algum agrupamento entre os vinhos.

Plotandos as relações das variáveis dos vinhos brancos:

plot(vw)

Clusterizando as variáveis:

Abaixo está sendo criada uma função para testar a variância dos dados em relação ao número de clusters:

elbow <- function(dataset){
  wss <- numeric(15)
  for (i in 1:15)
    wss[i] <- sum(kmeans(dataset,centers=i,
                         nstart=100)$withinss)
  plot(1:15, wss, type="b", main="Elbow method",
       xlab="Number of Clusters",
       ylab="Within groups sum of squares",
       pch=8, col="red")
}

elbow(vw)

Observações:

Conforme é possível identificar, o plot está mostrando que para o dataset ‘vw’, o mais recomendado é utilizar 2 clusters.

Criando um cluster em 2 grupos para distinguir vinhos bons de vinhos ruins:

#Cluster WHITE:
set.seed(10) 
modelo_white = kmeans(vw, centers = 2)
plot(vw, col=modelo_white$cluster)
points(modelo_white$centers, col = 4:1, bg = 1:4, pch = 24, cex=1, lwd=1)

Observações sobre o plot:

Analisando as relações, é possível identificar que as variáveis que o cluster conseguiu agrupar melhor em dois grupos foram as variáveis ‘totalsulfurdioxide’ e ‘freesulfurdioxide’ em relação a variável ‘quality’.

Analisando as variáveis ‘totalsulfurdioxide’ e ‘freesulfurdioxide’ separadamente:

vw%>%
  select(totalsulfurdioxide, freesulfurdioxide, quality) -> vinhos_white.r2
plot(vinhos_white.r2)

Clusterizando as variáveis:

set.seed(10) 
modelo_vinhos_white.r2 = kmeans(vinhos_white.r2, 
                                centers = 2) #utilizando 2 clusters
plot(vinhos_white.r2,
     col=modelo_vinhos_white.r2$cluster)
points(modelo_vinhos_white.r2$centers, col = 4:1, bg = 1:4, pch = 24, cex=1, lwd=1)

- Analisando o agrupamento, pode-se identificar que o cluster separou os vinhos em 2 grupos onde:

‘totalsulfurdioxide’ e ‘quality’: No grupo vermelho, ficaram os vinhos com ‘totalsulfurdioxide’ em média abaixo de 150 e os pretos acima de 150. ‘freesulfurdioxide’ e ‘quality’: No grupo vermelho, ficaram os vinhos com ‘freesulfurdioxide’ em média abaixo de 50 e os pretos acima de 50. Sendo que os grupos se juntão um pouco.

O grupo formado em ‘totalsulfurdioxide’ segue um agrupamento mais forte do que a variável ‘freesulfurdioxide’.
Conclusão sobre a técnica:

O algoritmo de cluster não é uma técnica muito adequada para agrupar os vinhos em categorias de vinhos bons e ruins.

O agrupamento realizado pelo algoritmo não classifica com muita precisão os vinhos de acordo com a variável ‘quality’. Podemos identificar que o grupo está distribuido em todas as notas de vinhos. Na nota 8, o grupo vermelho está em maior quantidade do que os pretos, na nota 3 para a variável ‘freesulfurdioxide’, o grupo preto está em maior quantidade em relação ao grupo vermelho.

trabalho-wine-statistica-fiap

Guilherme Kodama, Ana Raquel Cunha, Felipe Stangorlini

27/12/2018

EDA Dataset Qualidade de Vinhos

Objetivos

Etapa 1 - Análisa do dataset

Identificar NAs

Resumo dos dados

Visualizando as features

Etapa 1 - Análise sobre os dois tipos de vinhos

BoxPlot

Histogram

Etapa 1 - Correlação entre as features

Etapa 1 - PCA

Etapa 1 - Outliers

Etapa 1 - Conclusão

Etapa 2 - Preparação para dados de treino e teste

Etapa 2 - Regressão variável Quality

Etapa 2 - Regressão Linear

Etapa 2 - Árvore de regressão

Etapa 2 - Árvore de regressão - Dataset sem modificações

Etapa 2 - Árvore de regressão - Dataset sem outliers

Etapa 2 - Árvore de regressão - Dataset sem outliers e apenas vinhos do tipo WHITE

Etapa 2 - Árvore de regressão - Dataset sem outliers e apenas vinhos do tipo RED

Etapa 2 - Árvore de regressão - Resumo dos resultados finais

Etapa 2 - Comparação entre modelos

Etapa 3 - Classificação com variável Quality: Vinhos bons e ruins

Etapa 3 - Árvore de decisão

Etapa 3 - Regressão Logística

Etapa 3 - Comparação dos modelos

Etapa 4 - Análise sobre outras possíveis técnicas

Etapa 4 - Outras técnicas supervisionadas

Etapa 4 - Técnicas não supervisionadas